perm filename PRUNE.SAI[1,LMM] blob
sn#064372 filedate 1973-10-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PRUNE_DANISH" COMMENT MANAGER FOR DISK SYSTEMS
C00003 00003 BEGIN EXECUTION HERE
C00004 00004 BEGIN "DYNAMIC ALLOCATION"
C00007 00005 STRING PROCEDURE LINE(INTEGER I)
C00010 00006 OUTSTR("Type H<cr> for help. C<cr> for a list of commands.
C00022 ENDMK
C⊗;
BEGIN "PRUNE_DANISH" COMMENT MANAGER FOR DISK SYSTEMS;
COMMENT R.E. GORIN 25 MAY 72;
COMMENT TOUCHED BY RHT 11 NOV 72;
REQUIRE 2000 STRING_SPACE;
DEFINE CRLF="'15&'12",
DIRCHAN="1",
FCHAN="2",
PCHAN="3",
HEADER="""FILNAM EXT USER USE""&CRLF&CRLF";
INTEGER I,J,K,L,EOF,BRCHR,DIRSIZ;
INTEGER ARRAY LOOKUPBLOCK[0:5];
INTEGER EOF2,BRCHR2;
INTEGER FILENAME,EXT,LOSER,PPN;
BOOLEAN CHANGE;
STRING STR,COMLST;
EXTERNAL INTEGER _SKIP_;
EXTERNAL PROCEDURE SPOOL(STRING S;INTEGER IOCHAN,FLAGS);
COMMENT BEGIN EXECUTION HERE;
IF (I←CALL(0,"DSKPPN"))≠CALL(0,"GETPPN") THEN OUTSTR("PRUNING "&CVXSTR(I)&"
");
SETBREAK(3,"."&" ",NULL,"ISN");
OPEN(DIRCHAN,"DSK",'17,0,0,0,BRCHR,EOF);
LOOKUP(DIRCHAN,CVXSTR(I)&".UFD[1,1]",EOF);
IF EOF THEN USERERR(0,0,"CANT FIND UFD");
FILEINFO(LOOKUPBLOCK);
START_CODE
MOVS LOOKUPBLOCK[3];
ASH -2;
MOVNM DIRSIZ;
END;
BEGIN "DYNAMIC ALLOCATION"
INTEGER ARRAY DIRECTORY[1:DIRSIZ,0:3];
STRING ARRAY USE[1:DIRSIZ];
BOOLEAN PROCEDURE LESS(INTEGER A,B);
BEGIN
INTEGER A1,A2,B1,B2,ISLESS;
A1←DIRECTORY[A,1];
A2←DIRECTORY[A,0];
B1←DIRECTORY[B,1];
B2←DIRECTORY[B,0];
START_CODE
LABEL BAZ;
SETZM ISLESS;
HLRZ 1,A1;
HLRZ 2,B1;
CAME 1,2;
JRST BAZ;
HLRZ 1,A2;
HLRZ 2,B2;
CAME 1,2;
JRST BAZ;
HRRZ 1,A2;
HRRZ 2,B2;
BAZ: CAMLE 1,2;
SETOM ISLESS;
END;
RETURN(ISLESS);
END;
PROCEDURE SORT;
BEGIN INTEGER J,K,FATHER,SON,SON1,SON2;
FOR J ← 2 STEP 1 UNTIL DIRSIZ DO BEGIN
K ← J;
FATHER ← K LSH -1;
WHILE ((FATHER>0)∧LESS(K,FATHER)) DO BEGIN
FOR I←0 STEP 1 UNTIL 3 DO DIRECTORY[K,I]↔DIRECTORY[FATHER,I];
USE[K]↔USE[FATHER];
K ← FATHER;
FATHER ← K LSH -1;
END;
END;
FOR J ← DIRSIZ STEP -1 UNTIL 2 DO BEGIN
FOR I←0 STEP 1 UNTIL 3 DO DIRECTORY[1,I]↔DIRECTORY[J,I];
USE[1]↔USE[J];
FATHER ← 1;
SON1← FATHER LSH 1;
SON← SON2← SON1+1;
WHILE SON1 < J DO BEGIN
IF ((SON2 = J) ∨ LESS(SON1,SON2)) THEN SON ← SON1;
IF LESS(SON,FATHER) THEN BEGIN;
FOR I←0 STEP 1 UNTIL 3 DO DIRECTORY[SON,I]↔DIRECTORY[FATHER,I];
USE[SON]↔USE[FATHER];
FATHER ← SON;
SON1 ← FATHER LSH 1; SON ← SON2 ← SON1+1;
END ELSE DONE;
END;
END;
END;
STRING PROCEDURE LINE(INTEGER I);
RETURN(CVXSTR(DIRECTORY[I,0])&'11&CVXSTR(DIRECTORY[I,1])&'11&
CVXSTR(DIRECTORY[I,3])&'11&USE[I]&CRLF);
ARRYIN(DIRCHAN,DIRECTORY[1,0],(DIRSIZ)*4);
FOR J←1 STEP 1 UNTIL DIRSIZ DO IF
(K←DIRECTORY[J,0])
∧ ¬( ((L←(DIRECTORY[J,1]LAND '777777000000))=CVSIX("RPG "))
∨ ( (L=CVSIX("DAT ")) ∧ (K=CVSIX("PRUNE ")) ))
THEN BEGIN
DIRECTORY[J,1]←L;
DIRECTORY[J,3]←0;
END ELSE DIRECTORY[J,1]←-1;
SORT;
WHILE DIRECTORY[DIRSIZ,1]=-1 DO DIRSIZ←DIRSIZ-1;
RELEASE(DIRCHAN);
OPEN(FCHAN,"DSK",0,2,2,200,BRCHR2,EOF2);
LOOKUP(FCHAN,"PRUNE.DAT",EOF2);
IF ¬EOF2 THEN BEGIN
SETBREAK(1,'11&'12,'15,"ISN");
SETBREAK(2,'12,'11&'15,"ISN");
WHILE TRUE DO BEGIN
LABEL SNEXT,SERR,SERR1;
STR←INPUT(FCHAN,1);
IF EOF2 ∧ EQU(STR,NULL) THEN DONE;
IF BRCHR2≠'11 THEN BEGIN
SERR: IF BRCHR2≠'12 THEN STR←INPUT(FCHAN,2);
OUTSTR("ERROR IN PRUNE.DAT"&CRLF);
GO TO SNEXT;
END;
FILENAME←CVSIX(STR);
STR←INPUT(FCHAN,1);
IF BRCHR2≠'11 THEN GO TO SERR;
EXT←CVSIX(STR);
STR←INPUT(FCHAN,1);
IF BRCHR2≠'11 THEN GO TO SERR;
LOSER←CVSIX(STR);
STR←INPUT(FCHAN,2);
FOR J←1 STEP 1 UNTIL DIRSIZ DO
IF DIRECTORY[J,0]=FILENAME ∧ EXT = DIRECTORY[J,1] THEN
IF USE[J] THEN BEGIN
OUTSTR("REPEATED ENTRY: ");
GO TO SERR1;
END
ELSE BEGIN
DIRECTORY[J,3]←LOSER;
USE[J]←STR;
GO TO SNEXT;
END;
OUTSTR("NOT FOUND: ");
SERR1:OUTSTR(CVXSTR(FILENAME)&'11&CVXSTR(EXT)&'11&CVXSTR(LOSER)&'11&STR&CRLF);
SNEXT:END;
END;
CLOSE(FCHAN);
CHANGE←FALSE;
OUTSTR("Type H<cr> for help. C<cr> for a list of commands.
");
COMLST←"Commands:
W Write out PRUNE.DAT
F<file specifier> (Find) Types lines for specified files.
BF<file specifier> (Blank Find) Types lines for specified files with blank lines.
M<file specifier> (Modify) Changes lines for specified files.
BM<file specifier> (Blank Modify) Change lines for files with blank lines.
Z<file specifier> Edit lines specified with line editor (displays only)
D<file specifier> Delete (i.e. destroy) the named files.
BD<file specifier> Delete any specified files which have blank lines.
S<file specifier> Spool the specified files.
BS<file specifier> Spool any specified files with blank lines.
T<file specifier> Type the first few lines of the named files.
L List lines for all files on line printer
BL List lines with blank description on line printer
E Exit (Will warn of unwritten PRUNE.DAT file)
Where a <file specifer> is <filename>.<extension><tab><user>. Any of
these terms may be omitted and '*' will be assumed.
Example: 'FPRUNE' Finds all lines with PRUNE as a filename.
";
SETBREAK(7,NULL,NULL,"IAP");
WHILE TRUE DO BEGIN
INTEGER PROCEDURE FIND(INTEGER LAST);
BEGIN INTEGER I;
FOR I←LAST+1 STEP 1 UNTIL DIRSIZ DO
IF DIRECTORY[I,0] ∧
(FILENAME=CVSIX("*") ∨ FILENAME=DIRECTORY[I,0])
∧ (EXT=CVSIX("*") ∨ EXT=DIRECTORY[I,1])
∧ (PPN=CVSIX("*") ∨ PPN=DIRECTORY[I,3]) THEN RETURN(I);
RETURN(0);
END;
PROCEDURE FILESPEC;
BEGIN INTEGER BRKCHR;
IF (FILENAME←CVSIX(SCAN(STR←INCHWL,3,BRKCHR)))=0
THEN FILENAME←CVSIX("*");
IF BRKCHR≠"." ∨ (EXT←CVSIX(SCAN(STR,3,BRKCHR)))=0
THEN EXT←CVSIX("*");
IF BRKCHR≠" " ∨ (PPN←CVSIX(SCAN(STR,3,BRKCHR)))=0
THEN PPN←CVSIX("*");
END;
LABEL ERR,EAT,LIST1,FIND1,MODIFY,ZMODIFY,DEL1,SPOOL1;
BOOLEAN ALL;
INTEGER ZFLAG;
DEFINE TTYUUO="'51000000000";
INTEGER PROCEDURE ONEINLINE;
START_CODE
TTYUUO 4,1;
ANDI 1,'177; COMMENT FLUSH BUCKY BITS;
CAIL 1,'140; COMMENT CONVERT LOWER CASE TVR - OCT '72;
SUBI 1,'40
END;
EAT: OUTSTR("*");
ALL←TRUE;
CASE ONEINLINE OF BEGIN
["C"+0]BEGIN
IF INCHWL THEN GO TO ERR;
OUTSTR(COMLST);
GO TO EAT;
END;
["H"+0]BEGIN INTEGER CHN,CNT,BRK,EOF; COMMENT READ PRUNE[3,2]!;
IF INCHWL THEN GO TO ERR;
OPEN(CHN←GETCHAN,"DSK",0,2,0,CNT←80,BRK,EOF);
LOOKUP(CHN,"PRUNE[3,2]",EOF);
IF EOF THEN BEGIN OUTSTR("HELP FILE (PRUNE[3,2]) NOT FOUND");
GO TO EAT; END;
DO OUTSTR(INPUT(CHN,0)) UNTIL EOF;
RELEASE(CHN);
OUTSTR("
Type C<return> for a list of commands.
");
GO TO EAT;
END;
["B"+0]BEGIN
ALL←FALSE;
CASE ONEINLINE OF BEGIN
["F"+0]GO TO FIND1;
["M"+0]GO TO MODIFY;
["L"+0]GO TO LIST1;
["S"+0]GO TO SPOOL1;
["D"+0]GO TO DEL1
END;
END;
["W"+0]BEGIN
IF INCHWL THEN GO TO ERR;
ENTER(FCHAN,"PRUNE.DAT",EOF2);
IF EOF2 THEN OUTSTR("CAN'T ENTER PRUNE.DAT"&CRLF)
ELSE BEGIN
FOR I←1 STEP 1 UNTIL DIRSIZ DO
IF DIRECTORY[I,3] ∨ USE[I] THEN OUT(FCHAN,LINE(I));
CLOSE(FCHAN);
RENAME(FCHAN,"PRUNE.DAT",'200,EOF2);
CHANGE←FALSE;
END;
GO TO EAT;
END;
["F"+0]BEGIN
FIND1: FILESPEC;
I←0;
OUTSTR(HEADER);
WHILE I←FIND(I) DO
IF ALL ∨ ¬(DIRECTORY[I,3] ∨ USE[I]) THEN OUTSTR(LINE(I));
GO TO EAT;
END;
["M"+0]BEGIN
MODIFY: ZFLAG←FALSE;
ZMODIFY:FILESPEC;
I←0;
WHILE I←FIND(I) DO IF ALL ∨ ¬(DIRECTORY[I,3] ∨ USE[I]) THEN BEGIN
OUTSTR(LINE(I));
OUTSTR("NEW PROGRAMMER STRING?");
IF ZFLAG THEN LODED(CVXSTR(DIRECTORY[I,3])&'15);
COMMENT TVR - OCT '72;
STR←INCHWL;
IF _SKIP_='175 THEN BEGIN OUTSTR('15&'12);
DONE; END;
IF ¬EQU(STR,"∃") THEN BEGIN
DIRECTORY[I,3]←CVSIX(STR);
CHANGE←TRUE;
END;
OUTSTR("NEW USE STRING?");
IF ZFLAG THEN LODED(USE[I]&'15); COMMENT TVR - OCT '72;
STR←INCHWL;
IF _SKIP_='175 THEN BEGIN OUTSTR('15&'12); DONE; END;
IF ¬EQU(STR,"∃") THEN BEGIN
USE[I]←STR;
CHANGE←TRUE;
END;
END;
GO TO EAT;
END;
["Z"+0]BEGIN COMMENT LOAD LINE EDITOR DURING MODIFY;
START_CODE COMMENT PTGETL IS WRITTEN UP IN THE MANUAL
BUT THE COMPILER DOESN'T SEEM TO
KNOW ABOUT IT!;
SETOM ZFLAG;
TTYUUO 6,ZFLAG;
END;
IF ZFLAG LAND '420000000000 THEN GO TO ZMODIFY;
OUTSTR("I AM SORRY BUT THIS WILL NOT WORK ON A TELETYPE.
");
GO TO EAT;
END;
["L"+0]BEGIN
LIST1: IF INCHWL THEN GO TO ERR;
OPEN(PCHAN,"LPT",0,0,2,0,0,0);
OUT(PCHAN,HEADER);
FOR I←1 STEP 1 UNTIL DIRSIZ DO
IF DIRECTORY[I,0]∧
(ALL ∨ ¬(DIRECTORY[I,3] ∨ USE[I])) THEN
OUT(PCHAN,LINE(I));
RELEASE(PCHAN);
GO TO EAT;
END;
["S"+0] BEGIN
SPOOL1: FILESPEC;
I←0;
WHILE I←FIND(I) DO
IF (ALL ∨ ¬(DIRECTORY[I,3] ∨ USE[I])) THEN
BEGIN
STRING FID;
FID←CVXSTR(DIRECTORY[I,0])&"."&(CVXSTR(DIRECTORY[I,1]));
OUTSTR("SPOOL "&FID&"?");
IF EQU(STR←INCHWL,"Y") ∨ EQU(STR,"YES") THEN
SPOOL(FID,GETCHAN,0);
END;
GO TO EAT;
END;
["T"+0] BEGIN "TYPE"
FILESPEC;
I←0;
WHILE I←FIND(I) DO
BEGIN
STRING FID;INTEGER INCH;
INTEGER X,BC,CT;
FID←CVXSTR(DIRECTORY[I,0])&"."&
CVXSTR(X←DIRECTORY[I,1] LAND '777777000000);
IF X=CVSIX("DMP")∨X=CVSIX("REL")∨X=CVSIX("DAT") THEN
BEGIN
OUTSTR("DO YOU REALLY WANT TO TYPE FILE ");
OUTSTR(FID);
OUTSTR("?");
IF (INCHWL LAND '137)≠"Y" THEN CONTINUE;
END;
INCH←GETCHAN;
OPEN(INCH,"DSK",0,3,0,CT,BC,X);
LOOKUP(INCH,FID,X);
IF X THEN
BEGIN
OUTSTR("FILE NOT FOUND: ");
OUTSTR(FID);
OUTSTR('15&'12);
CONTINUE;
END;
CT←256;
OUTSTR(FID);OUTSTR(":
----------
");
DO BEGIN
OUTSTR(INPUT(INCH,7));
IF ¬X THEN
OUTSTR("
----------
Do you want to see more?")
ELSE
DONE;
END UNTIL (INCHWL LAND '137)≠"Y";
RELEASE(INCH);
OUTSTR("
↑↑↑↑↑↑↑↑↑↑
");
END;
GO TO EAT;
END;
["E"+0]IF INCHWL THEN GO TO ERR ELSE
BEGIN
IF CHANGE THEN
BEGIN
OUTSTR("FILE MODIFIED, BUT NOT WRITTEN. ARE YOU SURE YOU WANT TO EXIT?");
IF ¬(EQU(STR←INCHWL,"Y") ∨ EQU(STR,"YES")) THEN GO TO EAT;
END;
DONE;
END;
["D"+0] BEGIN
COMMENT DELETION OF FILES -- BLAME RHT FOR TROUBLES;
DEL1: FILESPEC;
I←0;
WHILE I←FIND(I) DO
IF (ALL ∨ ¬(DIRECTORY[I,3] ∨ USE[I])) THEN
BEGIN
STRING FID;
FID←CVXSTR(DIRECTORY[I,0])&"."&CVXSTR(DIRECTORY[I,1]);
OUTSTR("DO YOU REALLY WANT TO DELETE FILE "&FID&"?");
IF ¬(EQU(STR←INCHWL,"Y")∨EQU(STR,"YES")) THEN CONTINUE;
LOOKUP(FCHAN,FID,EOF2);
IF EOF2 THEN
BEGIN
OUTSTR(" LOOKUP FAILED FOR "&FID&'15&'12);
CONTINUE;
END;
RENAME(FCHAN,NULL,0,EOF2);
IF EOF2 THEN
BEGIN
OUTSTR(" RENAME FAILED FOR "&FID&'15&'12);
CONTINUE;
END;
OUTSTR("DELETED: "&FID&'15&'12);
CLOSE(FCHAN);
IF DIRECTORY[I,3] ∨ USE[I] THEN CHANGE←TRUE;
FOR J←0 STEP 1 UNTIL 3 DO DIRECTORY[I,J]←0;
USE[I]←NULL;
END;
GO TO EAT;
END;
['12]BEGIN
OUTSTR('15);
GO TO EAT;
END;
['137]BEGIN END; COMMENT SO WE DON'T GET CASE OVERFLOW! TVR - OCT '72;
['15]BEGIN
ONEINLINE;
GO TO EAT;
END
END;
INCHWL;
ERR:OUTSTR("HUH?, type 'H<cr>' for help"&CRLF);
END;
END "DYNAMIC ALLOCATION"
END "PRUNE_DANISH"